home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / PPC source / cg-regs < prev    next >
Text File  |  1998-11-03  |  48KB  |  2,072 lines
  1. marker m__cg-regs
  2.  
  3. PPC?
  4. [IF]
  5. false    constant    debug?
  6. false    constant    recompTest?
  7. [ELSE]
  8. false    constant    debug?
  9. false    constant    recompTest?
  10. [THEN]
  11.  
  12.  
  13. (* This file defines the classes we use to describe the PPC registers,
  14.    and creates the register objects.
  15. *)
  16.  
  17. 3        constant    spill_cnt        \ the number of regs we spill if we can't
  18.                                     \  otherwise get a free one
  19.  
  20. 0    value    #gprs_cleared            \ used by the spilling code, to count
  21.                                     \  the GPRs we actually free up
  22.  
  23. \ Some useful boilerplate instructions:
  24.  
  25. PPC?
  26. [IF]        \ In this case these are already defined
  27.             \  in the 68k image, and we can't interpret the << ops,
  28.             \  so we'll do it this way:
  29.             
  30.     LR>R0        constant    LR>R0        \ mflr  r0
  31.     R0>LR        constant    R0>LR        \ mtlr  r0
  32.     BLR            constant    BLR            \ unconditional branch to link reg
  33.  
  34. [ELSE]
  35.  
  36.     31 26 <<
  37.     8  16 << or
  38.     339 1 << or        constant    LR>R0    \ mflr  r0
  39.     
  40.     31 26 <<
  41.     8  16 << or
  42.     467 1 << or        constant    R0>LR    \ mtlr  r0
  43.  
  44.     19 26 <<
  45.   $ 14 21 <<  or
  46.     16  1 <<  or    constant    BLR        \ unconditional branch to link reg
  47.  
  48. [THEN]
  49.  
  50. : GPR>CTR  ( reg# -- )  21 <<  $ 7C0903A6 or  code,  ;
  51. : CTR>GPR  ( reg# -- )  21 <<  $ 7C0902A6 or  code,  ;
  52.  
  53. : nop,  ( -- )  $ 7C000378  code,  ;        \ or  r0, r0, r0
  54.  
  55.  
  56. forward  SPILL
  57. forward  check_for_moved_stores
  58.  
  59.  
  60. :class  REFERENCE_LIST  super{ reference obj_array }
  61.  
  62.     int    SIZE
  63.     
  64. :m SIZE:    inline{ get: size}    get: size  ;m
  65. :m >SiZE:    inline{ put: size}    put: size  ;m
  66. :m +SIZE:    inline{ +: size}    +: size    ;m
  67.  
  68. :m STK:  { n \ index -- }
  69.             \ Using self as a stack, selects the n'th
  70.             \  cell.  We don't report an error if n is greater than the
  71.             \  current depth, since there are situations in equalizing over
  72.             \  basic blocks where it would be a big pest to check all the time.
  73.             \  We just make sure such out-of-range cells return "noRef" type.
  74.  
  75.     ASSERT{ n 0> }        \ error if stk: called with a neg or zero index
  76.     get: size  n -  -> index
  77.     index 0<
  78.     IF    limit 1- select: self
  79.         noRef >refType: self
  80.     ELSE
  81.         index  select: self
  82.     THEN
  83. ;m
  84.  
  85. :m PUSH:    \ ( ^ref -- )
  86.     get: size  select: self
  87.     ->: self
  88.     1 +: size
  89. ;m
  90.  
  91. :m MOVEDOWN:        \ moves all items "down" to make room for another.
  92.                     \  Leaves element zero selected.
  93.     get: size
  94.     IF    get: size
  95.         FOR    i ^elem
  96.             i 1+ select: self
  97.             ->: self
  98.         NEXT
  99.     THEN
  100.     1 +: size
  101.     0 select: self
  102. ;m
  103.  
  104. :m MOVEUP:
  105.     get: size  NIF ." moveup: finds zero size" cr
  106.                     printall: self  ( 1 die )
  107.                THEN
  108.  
  109.     0 select: self  free: self        \ note - reg is now selected
  110.     
  111.     get: refType
  112.     SELECT[ gprRef ]=>    ?clear_GPR
  113.           [ crRef  ]=>    ?clear_CR
  114.  
  115.         DEFAULT=>        drop    \ not an error - just nothing to do
  116.     ]SELECT
  117.  
  118.     1 -: size
  119.     get: size  0
  120.     ?DO    i 1+ ^elem
  121.         i select: self
  122.         ->: self
  123.     LOOP
  124. ;m
  125.  
  126. :m SAVE:
  127.     get: size  0 
  128.     ?DO  i select: self  stack: self  LOOP
  129.     get: size
  130. ;m
  131.  
  132. :m RESTORE:
  133.     dup  put: size  ?dup 0EXIT
  134.     FOR  i select: self  unstack: self  NEXT
  135. ;m
  136.  
  137. :m PRINTALL:
  138.     ." depth: "  get: size .  cr
  139.     get: size 0<
  140.     IF    clear: size  EXIT  THEN
  141.     get: size  0EXIT
  142.     get: current
  143.     get: size
  144.     FOR  ?pause  i select: self  print: self  NEXT
  145.     select: self
  146. ;m
  147.  
  148. ;class
  149.  
  150.  
  151. 24    reference_list    CSTK        \ Compile time stack - maps the run-time
  152.                                 \ data stack to regs
  153.  
  154. 24    reference_list    CSTK2        \ Used in equalizing between basic blocks
  155. 24    reference_list    CSTK2_ORIG    \ Ditto
  156.  
  157. 24    reference_list    CSTK_TEMP    \ For scratch while equalizing
  158.  
  159. 24    reference_list    FCSTK        \ Floating compile time stack
  160.  
  161. 24    reference_list    FCSTK2
  162. 24    reference_list    FCSTK2_ORIG
  163.  
  164. 24    reference_list    FCSTK_TEMP
  165.  
  166.  
  167. objPtr    aRef    class_is reference
  168. objPtr    aRef2    class_is reference
  169.  
  170. objPtr    aRefL    class_is reference_list
  171.  
  172.  
  173.  
  174.  
  175. (*    ODs_CLASS is an array of OD objects, defined using obj_array.
  176.     We'll use this class for our 3 register files - GPRs, FPRs and CRs.
  177. *)
  178.  
  179.  
  180. :class    ODs_CLASS  super{ OD large_obj_array }
  181.  
  182. objPtr    spillODs  class_is ODs_class
  183.  
  184.     int        last_allocated
  185.     int        alloc_limit            \ last reg# we can allocate
  186.     int        1st_nonvolatile
  187.  
  188.  
  189. :m LAST_ALLOCATED:        get: last_allocated  ;m
  190. :m >LAST_ALLOCATED:        put: last_allocated  ;m
  191.  
  192. :m >ALLOC_LIMIT:        put: alloc_limit    ;m
  193.  
  194. private
  195.  
  196. (* We call is_reg_unused?: in the first loop while trying to find a free
  197.    reg.  An "unused" reg is preferable to one with a zero refCnt, since
  198.    the latter could still hold a valid value that could be reused in
  199.    future, or may have just recently been used and so not be avaliable
  200.    for retargetting an earlier op.
  201.    Factoring out this method allows us to tinker with it a bit.
  202. *)
  203.  
  204. :m is_reg_unused?:  ( -- b )
  205.  
  206.     (* First we can only grab a reg if its refCnt is zero.  If it's
  207.        nonzero, the reg is live, so we can't use it no matter what.
  208.        (This also allows us to block a particular reg being allocated,
  209.        even if it's empty, by setting its refcnt nonzero.  We need to
  210.        do this for CR0 in particular.
  211.     *)
  212.     get: refCnt IF  false  EXIT  THEN
  213.     
  214.     (* Now we look for a completely unused reg, or one with type
  215.        otUnknown and lastRefCDP at or before the current basic block
  216.        start.  That's just as good, as it could never be reused, and
  217.        could never block a retargetting.
  218.     *)
  219.     get: opType  NIF  true  EXIT  THEN
  220.     get: opType  otUnknownCodes >  IF  false  EXIT  THEN
  221.  
  222.     get: lastRefCDP  basic_block_start u<=
  223.     IF
  224.         get: opCDP  basic_block_start u>
  225.         IF
  226.             get: opCDP  put: lastRefCDP
  227.         THEN
  228.         true  EXIT
  229.     THEN
  230.     false
  231. ;m
  232.  
  233. public
  234.  
  235. (*    GetFreeReg: does just that.  We first try to find a completely unused
  236.     reg.  If that fails, we can do one of two things - we can grab a reg
  237.     which is inactive (zero refcnt) but with a valid value, or we
  238.     can spill some of the stack to memory which will free active
  239.     regs.  We used to try to keep at least 3 recently computed
  240.     values, and so spilled if there were 3 or less inactive regs.
  241.     But this was disastrous if we were doing an equalization, and
  242.     anyway a spill should probably be a last resort thing anyway.
  243.     So now we only spill if we're right out of regs.
  244.     
  245.     Note, that one thing that's tempting to do is call update_refcnts
  246.     in case there's a reg that's apparently referenced but really isn't.
  247.     This can happen.  But it's not safe to call update_refcnts here, since
  248.     we can be in the middle of doing just about anything when we need a
  249.     free reg.  We might have grabbed an operand or two into opnd1, opnd2
  250.     or res1, and no longer have a reference in cstk, which would lead
  251.     to us grabbing a reg that's in use.  We must only call update_refcnts
  252.     at places where we know it's safe.  So if we end up spilling regs when
  253.     one was really free already, that's just bad luck.
  254. *)
  255.  
  256.  
  257. :m GETFREEREG:  { \ found? reg# #inActive earliestInactive inactiveCDP
  258.                     spilled? -- reg# }
  259.  
  260.     false -> found?  false -> spilled?
  261.     0 -> #inActive  0 -> earliestInactive  -1 -> inactiveCDP
  262.  
  263.     BEGIN            \ will loop if there are no free regs and we have to spill
  264.  
  265.     \ first we try to find a completely unused reg:
  266.         get: alloc_limit 1+ 0
  267.         DO    i select: self
  268.             is_reg_unused?: self
  269.             IF
  270.                 debug? if
  271.                     ." allocating empty reg " i . cr
  272.                 then
  273.                 clear: self  allocate: self
  274.                 i  UNLOOP  EXIT
  275.             THEN
  276.             get: refCnt
  277.             NIF    1 ++> #inActive
  278.                 get: lastRefCDP inactiveCDP u<
  279.                 IF    get: lastRefCDP -> inactiveCDP
  280.                     i -> earliestInactive
  281.                 THEN
  282.             THEN
  283.         LOOP
  284.  
  285. \ not found yet.  We now look for an inactive reg.
  286.         #inactive 0>
  287.         IF
  288.             earliestInactive select: self
  289.             debug? if
  290.                 ." allocating inactive reg " print: myRef cr
  291.             then
  292.             clear: self  allocate: self
  293.             earliestInactive  EXIT
  294.         THEN
  295.         
  296. \ still none found.  We now spill to free up some regs.  If we've
  297. \  already spilled, we've got problems.  Hopefully this shouldn't
  298. \  happen.
  299.  
  300.         spilled? NIF  self -> spillODs  spill  ELSE  211 die  THEN
  301.  
  302.     AGAIN
  303. ;m
  304.  
  305.  
  306. :m ALLOCATE_REG:    \ ( reg# -- )
  307.     select: self  allocate: self  ;m
  308.  
  309. :m FREE_REG:        \ ( reg# -- )
  310.     select: self  free: self  ;m
  311.  
  312. :m ?DELETE_REG:        \ ( reg# -- )
  313.     select: self  ?delete: self  ;m
  314.  
  315.  
  316. :m MATCH?:  { ^OD canBeSpecial? \ svCurrent -- b }
  317.     get: current -> svCurrent
  318.     limit 0
  319.     DO    i select: self
  320.         get: special?
  321.         IF        canBeSpecial?
  322.         ELSE    true
  323.         THEN
  324.         IF    ^OD  =?: self
  325.             IF          \ equal, but need to check limit on validity
  326.                 CDP  get: validTillCDP  u<
  327.                 IF  unloop  true
  328.                     debug? if
  329.                         ." match?: matched on this reg: " print: myRef cr
  330.                     then
  331.                     EXIT
  332.                 THEN
  333.             THEN
  334.         THEN
  335.     LOOP
  336.     svCurrent  select: self
  337.     false
  338. ;m
  339.  
  340.  
  341. :m clearAll:
  342.     limit 0
  343.     DO    i select: self  full_clear: self
  344.     LOOP
  345.     -1 put: last_allocated
  346. ;m
  347.  
  348. :m clearAllVolatile:
  349.         \ called when we don't want a full clear on the nonvolatile regs.
  350.     get: 1st_nonvolatile  0
  351.     DO    i select: self  full_clear: self
  352.     LOOP
  353.     -1 put: last_allocated
  354. ;m
  355.  
  356. :m make_nonvolatiles_unknown:
  357.     limit  get: 1st_nonvolatile
  358.     DO    i select: self
  359.         otUnknown  put: opType
  360.     LOOP
  361. ;m
  362.  
  363. :m INVALIDATE_ALL:        \ when we just need to invalidate, not completely clear
  364.     limit 0
  365.     DO    i select: self  clear: opType
  366.     LOOP
  367. ;m
  368.  
  369.  
  370. :m CLEAR_REFCNTS:        \ called from update_refcnts - see comment there.
  371.     get: current
  372.     get: alloc_limit 0
  373.     DO    i select: self  clear: refCnt
  374.     LOOP
  375.     select: self
  376. ;m
  377.  
  378.  
  379. \ UPDATE_ALL_REFS: replaces all occurrences of oldRef by newRef in
  380. \ the OD array.  Used when we've moved a register.
  381.  
  382. :m UPDATE_ALL_REFS:  { ^oldRef ^newRef fromCDP -- }
  383.     get: current
  384.     limit 0
  385.     DO    i select: self  ^oldRef ^newRef fromCDP  update_refs: self
  386.     LOOP
  387.     select: self
  388. ;m
  389.  
  390. \ REG_CHANGED: looks after the situation where a reg is getting changed,
  391. \ so for any regs which depend on the changed reg, we need to set its
  392. \ validTillCDP ivar to the current CDP.
  393.  
  394. :m REG_CHANGED:  { ^ref -- }
  395.     get: current
  396.     limit 0
  397.     DO    i select: self  ^ref ?antecedent_changed: self
  398.     LOOP
  399.     select: self
  400. ;m
  401.  
  402.  
  403. :m INVALIDATE_ON_OVERLAP:  { ^OD \ svCurrent -- }
  404.     get: current -> svCurrent
  405.     limit 0
  406.     DO    i select: self
  407.         ^OD  overlap?: self
  408.         IF          \ overlaps, but need to check limit on validity
  409.             CDP  get: validTillCDP  u<
  410.             IF
  411.                 debug? if
  412.                     blit: self  .h  ^OD blit: class_as> OD .h cr
  413.                     ." overlap?: matched on this reg: " print: self cr
  414.                     ." overlapping OD: "  print: [ ^OD ] cr
  415.                 then
  416.  
  417.                 CDP 4-  put: validTillCDP
  418.                 otUnknown  put: opType
  419.                 noType       put: instrnType
  420.                 addr: myRef  reg_changed: self
  421.             THEN
  422.         THEN
  423.     LOOP
  424.     svCurrent  select: self
  425. ;m
  426.  
  427.  
  428. :m UPDATE_opCDPs:
  429.     get: current
  430.     limit 0
  431.     DO    i select: self  update_opCDP: self
  432.     LOOP
  433.     select: self
  434. ;m
  435.  
  436. :m MAKE_ALTERED_REGS_UNKNOWN:
  437.     get: current
  438.     limit 0
  439.     DO    i select: self  make_unknown_if_altered: self
  440.     LOOP
  441.     select: self
  442. ;m
  443.  
  444.  
  445. :m MAKE_FETCHES_UNKNOWN:
  446.     get: current
  447.     limit 0
  448.     DO    i select: self  make_unknown_if_fetch: self
  449.     LOOP
  450.     select: self
  451. ;m
  452.  
  453.  
  454. :m ?HOIST_ALL:
  455.     get: current
  456.     limit 1
  457.     DO    i select: self  ?hoist: self  drop
  458.     LOOP
  459.     select: self
  460. ;m
  461.  
  462.  
  463. (* MOVEREG: moves an operand from one reg to a different one - we might have
  464.    to do this when equalizing the stack, for example.  If possible we just
  465.    recompile the operation that generated the original result, to generate it
  466.    straight in the new reg.  If all else fails we'll actually compile an
  467.    instruction to move the operand.
  468.    We leave the destination register selected.
  469. *)
  470.  
  471.  
  472. :m REG_MOVED:  { old# recompiled? -- }
  473.             \ housekeeping routine called after a move.  The new reg is currently
  474.             \ selected.  We update references and clear the old reg.
  475.  
  476.     debug? if
  477.         ." reg_moved: called - dest:" print: self
  478.     then
  479.     
  480.     addr: myRef  dup  ->: tmpRef1  ->: tmpRef2  old# >reg: tmpRef1
  481.     tmpRef1 tmpRef2  get: opCDP 4+
  482.     current: self  old# select: self
  483.     \ clear: super
  484.     recompiled?
  485.     IF        clear: self  ref_gone: self
  486.     ELSE    CDP 4- put: lastRefCDP
  487.     THEN
  488.     select: self
  489.     update_refs
  490. ;m
  491.  
  492.  
  493. :m MOVEREG_BY_RECOMPILING?:  { old# new# -- recompile? }
  494.     old# select: self
  495.     addr: self  copyOD: theOD    \ move old operand into theOD for convenience
  496.                                 \  need ALL ivars unchanged in this move
  497.     new# select: self
  498.  
  499.     recompTest? if
  500.         ." movereg_by_recompiling?" cr
  501.         ." source reg in theOD:"    print: theOD cr
  502.         ." dest reg:           "    print: self  cr
  503.         ." eq_block_recompiling_move? "    eq_block_recompiling_move? . cr
  504.         ." backstop_CDP        "    backstop_CDP .h cr
  505.         ." basic_block_start:  "    basic_block_start .h cr
  506.         ." lastRefCDP in dest  "    get: lastRefCDP .h cr
  507.     then
  508.  
  509.     false
  510.  
  511. \ Now we decide if we can handle a move by just recompiling the op.  There are
  512. \  several things to check.  Note we don't check fetch_backstop, since when we
  513. \  recompile an op we don't move it, so we can assume any fetches are valid
  514. \  in their existing location.  fetch_backstop only limits where we can
  515. \  move NEW fetches back to.
  516.  
  517.     recompTest?
  518.     if
  519.         [ ppc? ] [if] dbgr [then]
  520.     then
  521.  
  522.     move_by_recompiling?        0EXIT
  523.                         \ for debugging or whatever, we can turn this
  524.                         \  optimization off
  525.     
  526.     eq_block_recompiling_move?  ?EXIT
  527.                         \ if back equalizing, we're doing low-level things
  528.                         \  with regs and mustn't try to change anything.
  529.  
  530.     get: ivar> special? in theOD  ?EXIT
  531.                         \ can't recompile if the old reg is a local or
  532.                         \  base reg or whatever (which can't move)
  533.  
  534.     get: ivar> opType in theOD  otUnknownCodes <=  ?EXIT
  535.                         \ or if the old reg is empty or of unknown type
  536.                         \  (i.e. nothing to recompile)
  537.  
  538.     get: ivar> opCDP in theOD  basic_block_start    u<  ?EXIT
  539.                         \ or if its op wasn't in the current basic blk
  540.  
  541.     get: ivar> opCDP in theOD   backstop_CDP        u<  ?EXIT
  542.                         \ or if it would be past the backstop
  543.                         
  544.     get: lastRefCDP  get: ivar> opCDP in theOD        u>  ?EXIT
  545.                         \ or if the last ref to the NEW reg was after the op
  546.                         \  we want to recompile, since we'd clobber that use.
  547.                         \ note we use >, not >=, since it's OK if the instrn
  548.                         \  we're recompiling uses its own reg as an operand.
  549.  
  550. \ if we got here, it's OK to recompile the op!
  551.  
  552.     drop                \ drop false flag
  553.  
  554.     recompTest? if
  555.         ." moving by recompiling " old# . ."  to " new# . cr
  556.     then
  557.  
  558.     theOD copyWithCDP: self
  559.     get: ivar> refcnt in theOD  put: refcnt
  560.     recompile: self
  561.  
  562.     old# new# addr: myRef  check_for_moved_stores
  563.     
  564.     old# true reg_moved: self
  565.     true
  566. ;m
  567.  
  568.  
  569. :m MOVEREG:  { old# new# updateRefs? \ extraRefs? -- }
  570.  
  571.     debug? recompTest? or if
  572.         ." moveReg: called, to move " old# . ."  to " new# . cr
  573.     then
  574.  
  575.     new# select: self
  576.     old# new# =  ?EXIT            \ just in case
  577.  
  578. \ now we need to check if we have any extra refs to this dest reg
  579. \  on cstk.  If we do, these refs need the old value, so we'll have
  580. \  to save the old value to a new reg before we change the dest.
  581. \ Note that we mustn't do this during equalization when we presumably
  582. \  have everything under control and mustn't try to second-guess.
  583.  
  584.     equalizing?
  585.     NIF
  586.         false -> extraRefs?
  587.         size: cstk 1+ 1
  588.         ?DO    i stk: cstk
  589.             addr: myRef =?: cstk
  590.             IF
  591.                 debug? if
  592.                     ." we have another ref to the dest reg, in cell " i . cr
  593.                     printall: cstk
  594.                 then
  595.         
  596.                 extraRefs?
  597.                 NIF        \ first time - get the new reg
  598.                     true -> extraRefs?
  599.                     getFreeReg: self  drop
  600.                     new# compile_reg_move: self
  601.                 THEN
  602.                 addr: myRef  ->: cstk
  603.             THEN
  604.         LOOP
  605.     THEN
  606.  
  607.     old# new# moveReg_by_recompiling?: self  ?EXIT
  608.     new# select: self
  609.     old# compile_reg_move: self
  610.     
  611.     debug? recompTest? or if
  612.         ." moved by compiling a move, from " old# . ."  to " new# . cr
  613.     then
  614.  
  615.     old# -1  addr: myRef  check_for_moved_stores
  616.     updateRefs?
  617.     IF    old# false reg_moved: self
  618.         new# select: self
  619.     THEN
  620. ;m
  621.  
  622.  
  623. \ next_CDP: returns the CDP of the following op -- this is used to
  624. \  check limits for hoisting.  But if our CDP is one of the special
  625. \  low values, we return it unchanged.
  626.  
  627. :m next_CDP:  ( index -- next_CDP)
  628.     current: self >r
  629.     select: self
  630.     get: permanent?
  631.     IF  16
  632.     ELSE
  633.         get: opCDP dup 16 u>
  634.         IF                    \ not a special value - return the CDP of the next op
  635.             get: length +  
  636.         THEN
  637.     THEN
  638.     r> select: self
  639. ;m
  640.  
  641. :m USE_THIS:  ( CDP_to_use reg# -- )
  642.     current: self >r
  643.     select: self  mark_use: super
  644.     r> select: self
  645. ;m
  646.  
  647. :m PRINT:
  648.     cr
  649.     ." current: "  get: current  .
  650.     print: super
  651. ;m
  652.  
  653. :m PRINTALL:
  654.     cr
  655.     ." current: "  get: current  dup .  cr
  656.     ." last allocated:  " print: last_allocated  cr
  657.  
  658.     limit 0
  659.     DO    i select: self
  660.         get: opType
  661.         IF
  662.             i .  print: super  cr
  663.         THEN
  664.     LOOP
  665.     select: self
  666. ;m
  667.  
  668. :m .ALLOCATED:
  669.     get: current
  670.     limit 0
  671.     DO    i select: self  get: refCnt
  672.         IF  i .  4 spaces ." refCnt "  get: refCnt .  cr
  673.         THEN
  674.     LOOP  cr
  675.     select: self
  676. ;m
  677.  
  678. :m .FREE:
  679.     cr
  680.     get: current
  681.     limit 0
  682.     DO    i select: self  get: refCnt
  683.         NIF  i .  cr
  684.         THEN
  685.     LOOP
  686.     select: self
  687. ;m
  688.  
  689. :m INIT:  { myRefType my_alloc_limit 1st_nonvol -- }
  690.     1st_nonvol  put: 1st_nonvolatile
  691.     limit 0
  692.     DO    i select: self
  693.         myRefType  >refType: myRef  i >reg: myRef
  694.     LOOP
  695.     my_alloc_limit  put: alloc_limit
  696. ;m
  697.  
  698. :m CLASSINIT:
  699.     clearall: self
  700. ;m
  701.  
  702. PPC?
  703. [IF]        \ may not really need this to be conditional, but I'm
  704.             \  cautious...
  705.  
  706. :m DEEP_CLASSINIT: { \ xx -- }    \ Need this for setting up when we initialize ofter
  707.                     \  target compilation, since the regular CLASSINIT:
  708.                     \  doesn't get done.  Need to override, or it will
  709.                     \  just call the method in the first superclass OD.
  710.  
  711.     idxBase 4+  addr: xdispl  displ!
  712.     ^base  classinit: class_as> OD    \ actually can omit once it's working
  713.                                     \  since ivSetup calls classinit: on
  714.                                     \  ALL superclasses.
  715.     (^base) -> newObject
  716.     ['] ODs_class ( dup -> xx )  ifa displace  0  0
  717.     ivSetup
  718. ;m
  719.  
  720. [THEN]
  721.  
  722. ;class
  723.  
  724.  
  725. 32    ODs_class    GPRs            PPC? not [IF]  gprRef 10 13  init: GPRs  [THEN]
  726. 32    ODs_class    FPRs            PPC? not [IF]  fprRef 13 14  init: FPRs  [THEN]
  727.  8    ODs_class    CRs                PPC? not [IF]  CRref   7  4  init: CRs   [THEN]
  728.  
  729. 32    ODs_class    STORED_GPRs        PPC? not [IF]  gprRef 10 0  init: stored_GPRs  [THEN]
  730. 32    ODs_class    STORED_FPRs        PPC? not [IF]  fprRef 10 0  init: stored_FPRs  [THEN]
  731.  
  732. PPC?
  733. [IF]
  734. 32    ODs_class    VRs
  735. [THEN]
  736.  
  737. \ Note: when target compiling we can't send messages at compile time, so we
  738. \  can't send init:.  So we do it at SETUP_CG in cg7.  The code there should
  739. \  agree with the above.
  740.  
  741.  
  742. objPtr    theRegs  class_is ODs_class        \ Used to point to the appropriate bank
  743.                                         \  of regs in code which can apply to
  744.                                         \  more than one
  745.  
  746.  
  747. \ Now we need to permanently allocate regs which we can't use for 
  748. \ general operands:
  749.  
  750. : ALLOCATE_RESERVED_REGS
  751.     current: GPRs  current: FPRs
  752.  
  753.     0                allocate_reg: GPRs  special: GPRs
  754.     rX_reg            allocate_reg: GPRs    special: GPRs
  755.     rY_reg            allocate_reg: GPRs    special: GPRs
  756.     rZ_reg            allocate_reg: GPRs    special: GPRs
  757.     SP_reg            allocate_reg: GPRs  special: GPRs
  758.     FSP_reg            allocate_reg: GPRs  special: GPRs
  759.     SP_reg sys_SP_reg <>
  760.     IF
  761.         sys_SP_reg    allocate_reg: GPRs  special: GPRs
  762.     THEN
  763.     RTOC_reg        allocate_reg: GPRs  permanent: GPRs
  764.     mainData_reg    allocate_reg: GPRs  permanent: GPRs
  765.     modData_reg        allocate_reg: GPRs  permanent: GPRs
  766.     mainCode_reg    allocate_reg: GPRs  permanent: GPRs
  767.     modCode_reg        allocate_reg: GPRs  permanent: GPRs
  768.     RP_reg            allocate_reg: GPRs  special: GPRs
  769.     obj_base_reg    allocate_reg: GPRs  permanent: GPRs
  770.  
  771.     32 1st_gpr_local
  772.     DO    i select: GPRs  1 put: ivar> refCnt in GPRs  special: GPRs
  773.     LOOP
  774.  
  775. \ now the FPRs
  776.     0                allocate_reg: FPRs  special: FPRs
  777.  
  778.     32 1st_fpr_local
  779.     DO    i select: FPRs  1 put: ivar> refCnt in FPRs  special: FPRs
  780.     LOOP
  781.     
  782.     select: FPRs  select: GPRs
  783. ;
  784.  
  785.  
  786. PPC? not [IF]  allocate_reserved_regs  [THEN]
  787.  
  788.  
  789. \ We use these objects to keep track of the operands and results of the
  790. \ operation we're currently compiling:
  791.  
  792.     reference    OPND1
  793.     reference    OPND2
  794.     reference    OPND3
  795.     reference    OPND4
  796.     
  797.     reference    RES1
  798.     reference    RES2
  799.     reference    RES3
  800.     
  801.     reference    TMPREF
  802.  
  803.     0    value    EXIT_CHAIN
  804.     
  805.  
  806. :f ALLOCATE_GPR    allocate_reg: GPRs    ;f
  807. :f ALLOCATE_FPR    allocate_reg: FPRs    ;f
  808. :f ALLOCATE_CR    allocate_reg: CRs    ;f
  809.  
  810. :f FREE_GPR        free_reg: GPRs    ;f
  811. :f FREE_FPR        free_reg: FPRs    ;f
  812. :f FREE_CR        free_reg: CRs    ;f
  813.  
  814. :f DEL_GPR        ?delete_reg: GPRs    ;f
  815. :f DEL_FPR        ?delete_reg: FPRs    ;f
  816. :f DEL_CR        ?delete_reg: CRs    ;f
  817.  
  818. :f ?CLEAR_GPR    get: ivar> refCnt in GPRs
  819.                 NIF  clear: ivar> opType in GPRs  1 ++> #gprs_cleared  THEN
  820. ;f
  821.  
  822. :f ?CLEAR_FPR    get: ivar> refCnt in FPRs
  823.                 NIF  clear: ivar> opType in FPRs  THEN
  824. ;f
  825.  
  826. :f ?CLEAR_CR    get: ivar> refCnt in CRs
  827.                 NIF  clear: ivar> opType in CRs  THEN
  828. ;f
  829.  
  830. :f USE_GPR        use_this: GPRs  ;f
  831. :f USE_FPR        use_this: FPRs  ;f
  832. :f USE_CR        use_this: CRs   ;f
  833.  
  834. :f SET_CR0        0 select: CRs
  835.                 put: ivar> opCDP in CRs
  836.                 put: ivar> opType in CRs  ;f
  837.  
  838. :f GPR_next_CDP        next_CDP: GPRs  ;f
  839. :f FPR_next_CDP        next_CDP: FPRs  ;f
  840. :f CR_next_CDP        next_CDP: CRs  ;f
  841.  
  842.  
  843.  
  844. (*    UPDATE_REFCNTS checks cstk and ensures that the refcnt fields in all regs
  845.     are correct.  Basic block boundaries or updating refs may get things out
  846.     of kilter, so this ensures everything's back to what it should be.
  847. *)
  848.  
  849. : UPDATE_REFCNTS
  850.     clear_refCnts: GPRs
  851.     clear_refCnts: FPRs
  852.     clear_refCnts: CRs
  853.  
  854. \ don't worry about refCnts in stored_GPRs
  855.  
  856.     size: cstk 1+ 1
  857.     ?DO    i stk: cstk  allocate: cstk
  858.     LOOP
  859.     
  860.     size: fcstk 1+ 1
  861.     ?DO    i stk: fcstk  allocate: fcstk
  862.     LOOP
  863.  
  864.     allocate_reserved_regs
  865. ;
  866.  
  867.  
  868. : MAKE_ALTERED_REGS_UNKNOWN
  869.     [ debug? ] [if]
  870.         ." make_altered_regs_unknown called" cr
  871.     [then]
  872.     make_altered_regs_unknown: GPRs
  873.     make_altered_regs_unknown: FPRs
  874.     make_altered_regs_unknown: CRs
  875.     make_altered_regs_unknown: stored_GPRs
  876. ;
  877.  
  878.  
  879. objPtr    match_regs        class_is  ODs_class
  880. objPtr  stored_regs        class_is  ODs_class
  881.  
  882. : match_stores?  { ^regs ^stored_regs ^OD store-code canBeSpecial? 
  883.                     \ sv_opType -- ^OD' true | -- false }
  884.  
  885.     ^regs -> match_regs  ^stored_regs -> stored_regs
  886.  
  887.     debug? if
  888.         ." match? didn't match fetch on regs" cr
  889.         ." - now attempting to match with stored regs:" cr
  890.         print: [ ^OD ]
  891.         cr ." stored regs: " cr
  892.         printall: stored_regs cr
  893.     then
  894.  
  895.     ^OD  get: ivar> opType in class_as> OD  -> sv_opType
  896.     store-code  ^OD put: ivar> opType in class_as> OD
  897.     
  898.     ^OD  canBeSpecial?  match?: stored_regs
  899.     
  900.     sv_opType  ^OD put: ivar> opType in class_as> OD        \ restore it
  901.  
  902.     debug? if
  903.         dup if ." matched on stored regs" else ." didn't match stored regs" then cr cr
  904.     then
  905.  
  906.     NIF    false    EXIT  THEN
  907.  
  908. \ we've matched on a stored reg.  We use it, but change its type 
  909. \  in GPRs/FPRs to otUnknown so we can't change it again.  Any attempt
  910. \  to recompile it, say, would clobber the store (the voice of
  911. \  experience).
  912.  
  913.     current: stored_regs  select: match_regs
  914.  
  915.     addr: stored_regs  copyOD: match_regs
  916.     otUnknown  put: ivar> opType in match_regs
  917.     debug? if
  918.         ." changed type in match_regs to otUnknown:"
  919.         print: match_regs
  920.     then
  921.     CDP  put: ivar> lastRefCDP in match_regs
  922.     big# put: ivar> validTillCDP in match_regs
  923.     addr: match_regs  true
  924. ;
  925.  
  926.  
  927. : MATCH?  { ^OD canBeSpecial? \ opType -- ^OD' true | -- false }
  928.  
  929.     allow_match?  NIF  false  EXIT  THEN
  930.  
  931.     ^OD get: ivar> opType in OD  -> opType
  932.     
  933.     opType  otFPstart otFPend  within? nip
  934.     IF                                \ it's an FP op - just check FPRs
  935.         ^OD canBeSpecial?  match?: FPRs
  936.         IF  addr: FPRs    true  ELSE  false  THEN  EXIT
  937.     THEN
  938.  
  939.     ^OD canBeSpecial?  match?: GPRs        IF  addr: GPRs    true  EXIT  THEN
  940.     ^OD canBeSpecial?  match?: CRs        IF  addr: CRs    true  EXIT  THEN
  941.  
  942. \ now if the op is a fetch, we need to check for a match on the stores of
  943. \  that kind of register.  Note that the myRef ivar in the passed-in OD
  944. \  may not be set, so we use opType.
  945.  
  946.     opType otFetch =
  947.     IF    GPRs stored_GPRs ^OD otStore canBeSpecial? match_stores?  EXIT  THEN
  948.     opType otFPfetch =
  949.     IF  FPRs stored_FPRs ^OD otFPstore canBeSpecial? match_stores?  EXIT  THEN
  950.  
  951.     false
  952. ;
  953.  
  954.  
  955.  
  956. objPtr    rcRef    class_is reference
  957.  
  958. :f REG_CHANGED  { ^ref -- }
  959.     ^ref reg_changed: GPRs
  960.     ^ref reg_changed: FPRs
  961.     ^ref reg_changed: CRs
  962.     
  963. \ Now if this is a GPR, we also clobber the corresponding element in
  964. \ stored_GPRs, since any value that was stored isn't in this GPR any more.
  965.  
  966.     ^ref -> rcRef
  967.     refType: rcRef  GPRref =
  968.     IF    reg: rcRef  select: stored_GPRs
  969.         clear: ivar> opType in stored_GPRs
  970.     THEN
  971. ;f
  972.  
  973.  
  974. : UPDATE_EQ_RANGES
  975.     reset: eq_ranges
  976.     BEGIN
  977.         len: eq_ranges  0EXIT
  978.         nxtL: eq_ranges  startCDP u>
  979.     UNTIL
  980.     -4 skip: eq_ranges
  981.     BEGIN
  982.         1stL: eq_ranges
  983.         deltaCDP +  >nxtL: eq_ranges
  984.         len: eq_ranges
  985.         dup 0< if . ."  auugggh!" QUIT then
  986.     NUNTIL
  987. ;
  988.  
  989.  
  990. :f UPDATE_CDPs        \ ( startCDP deltaCDP -- )
  991.  
  992.     -> deltaCDP  -> startCDP
  993.     update_opCDPs: GPRs
  994.     update_opCDPs: FPRs
  995.     update_opCDPs: CRs
  996.     
  997.     update_opCDPs: stored_GPRs
  998.     
  999.     basic_block_start  startCDP u>
  1000.     IF  deltaCDP ++> basic_block_start  THEN
  1001.  
  1002.     loop_start  startCDP u>
  1003.     IF  deltaCDP ++> loop_start  THEN
  1004.  
  1005.     update: control_stk
  1006.     update_eq_ranges
  1007.     fix_containing_loop
  1008. ;f
  1009.  
  1010.  
  1011. objPtr  MS_check_regs    class_is ODs_class
  1012.  
  1013. :f check_for_moved_stores  { old# new# ^ref -- }
  1014.  
  1015.     ^ref  refType: class_as> reference
  1016.  
  1017.     SELECT[    GPRref    ]=>        stored_GPRs -> MS_check_regs
  1018.           [    FPRref    ]=>        stored_FPRs -> MS_check_regs
  1019.               DEFAULT=>  drop  EXIT
  1020.     ]SELECT
  1021.  
  1022.     old# select: MS_check_regs
  1023.     get: ivar> opType in MS_check_regs  otStore =
  1024.     IF
  1025.         new# 0>=
  1026.         IF
  1027.             debug? if
  1028.                 cr
  1029. ." moving a store since source reg has moved from " old# . ." to " new# . cr
  1030.             then
  1031.  
  1032.             addr: MS_check_regs
  1033.             new# select: MS_check_regs
  1034.             copyWithCDP: MS_check_regs
  1035.             recompile: MS_check_regs
  1036.             old# select: MS_check_regs
  1037.         THEN
  1038.         clear: ivar> opType in MS_check_regs
  1039.     THEN
  1040. ;f
  1041.  
  1042.  
  1043. false    value    USING_CR0
  1044.  
  1045.  
  1046. (* MOVE_CR_BIT moves a bit in the CR from one position to another.
  1047.    Note that we can't do this by recompiling the op, since the op
  1048.    was a compare or an arith instruction that necessarily put the
  1049.    bit where it ended up (except for the one case where it was a
  1050.    test for the SAME condition which happened to be sent to a different
  1051.    CR field).
  1052.    The move can be done in one instruction - either a cror or crnor
  1053.    depending on whether the 1_is_true? bit is the same or different.
  1054. *)
  1055.  
  1056. : MOVE_CR_BIT  { srcRef dstRef \ whichSrcBit whichDstBit -- }
  1057.     debug? if
  1058.         ." move_cr_bit called with: "  print: [ srcRef ]  print: [ dstRef ] cr
  1059.     then
  1060.  
  1061.     false -> check_OP_stores?    \ classes mightn't match (might be cstk)
  1062.                                 \  but doesn't matter here
  1063.     srcRef -> aRef
  1064.     dstRef -> aRef2
  1065.     true -> check_OP_stores?
  1066.  
  1067.     clear: instrn
  1068.     19 >primOp: instrn
  1069.     1_is_true?: aRef  1_is_true?: aRef2  =
  1070.     IF        449                    \ cror
  1071.     ELSE    33                    \ crnor
  1072.     THEN  >secOp: instrn
  1073.     reg: aRef  4*  bit#: aRef  or  -> whichSrcBit
  1074.     reg: aRef2 4*  bit#: aRef2 or  -> whichDstBit
  1075.     whichSrcBit dup >rA: instrn  >rB: instrn
  1076.     whichDstBit  >rD: instrn
  1077.     compile: instrn
  1078. ;
  1079.  
  1080.  
  1081. \            ===============================================
  1082.  
  1083. \ More utility words
  1084.  
  1085.  
  1086. : STK    \ Selects the nth cstk cell (1 is top)
  1087.     stk: cstk  ;
  1088.  
  1089. : FSTK
  1090.     stk: fcstk  ;
  1091.  
  1092. : POP  { ^ref -- }
  1093.     size: cstk
  1094.     IF    1 stk  cstk ^ref ->: class_as> reference
  1095.         -1 +size: cstk
  1096.     ELSE        \ no operands in regs - we just have to adjust stk_offset
  1097.         1cell  ++> stk_offset
  1098.         noRef  ^ref >refType: class_as> reference
  1099.     THEN
  1100. ;
  1101.  
  1102. : FPOP  { ^ref -- }
  1103.     size: fcstk
  1104.     IF    1 fstk  fcstk ^ref ->: class_as> reference
  1105.         -1 +size: fcstk
  1106.     ELSE        \ no operands in regs - we just have to adjust stk_offset
  1107.         fpcell  ++> fstk_offset
  1108.         noRef  ^ref >refType: class_as> reference
  1109.     THEN
  1110. ;
  1111.  
  1112. : PUSH    \ ( ^ref -- )
  1113.     push: cstk  ;
  1114.  
  1115. : FPUSH    \ ( ^ref -- )
  1116.     push: fcstk  ;
  1117.  
  1118.  
  1119. : INIT_CSTK
  1120.     0 >size: cstk  ;
  1121.  
  1122. : INIT_FCSTK
  1123.     0 >size: fcstk  ;
  1124.  
  1125.  
  1126. : INIT_GPRs
  1127.     debug? if
  1128.         ." init_gprs called - clearing everything" cr
  1129.     then
  1130.  
  1131.     clearAll: GPRs
  1132.     clearAll: CRs
  1133.     clearAll: stored_GPRs
  1134.     allocate_reserved_regs
  1135. ;
  1136.  
  1137. : INIT_FPRs
  1138.     debug? if
  1139.         ." init_fprs called - clearing everything" cr
  1140.     then
  1141.  
  1142.     clearAll: FPRs
  1143.     clearAll: stored_FPRs
  1144.     allocate_reserved_regs
  1145. ;
  1146.  
  1147. : INIT_VOLATILE_GPRs
  1148.  
  1149.     debug? if
  1150.         ." init_volatile_gprs called" cr
  1151.     then
  1152.  
  1153.     clearAllVolatile: GPRs
  1154.     clearAll: CRs
  1155.     clearAll: stored_GPRs
  1156.     allocate_reserved_regs
  1157. ;
  1158.  
  1159. : INIT_VOLATILE_FPRs
  1160.  
  1161.     debug? if
  1162.         ." init_volatile_gprs called" cr
  1163.     then
  1164.  
  1165.     clearAllVolatile: FPRs
  1166.     clearAll: stored_FPRs
  1167.     allocate_reserved_regs
  1168. ;
  1169.  
  1170.  
  1171. : set_backstop_CDP
  1172.     CDP -> backstop_CDP  ( init_volatile_regs )
  1173. ;
  1174.  
  1175.  
  1176. : (SETUP_CSTK)  { #gprs init? -- }
  1177.     init? IF  init_gprs  ELSE  init_volatile_gprs  THEN
  1178.     init_cstk
  1179.     #gprs 0
  1180.     ?DO    i 3+ dup allocate_reg: GPRs  >GPR: res1
  1181.         otUnknown  put: ivar> opType in GPRs
  1182.         noType       put: ivar> instrnType in GPRs
  1183.         res1 push
  1184.     LOOP
  1185. ;
  1186.  
  1187. : (SETUP_FCSTK)  { #fprs init? -- }
  1188.     init? IF  init_fprs  ELSE  init_volatile_fprs  THEN
  1189.     init_fcstk
  1190.     #fprs 0
  1191.     ?DO    i 1+ dup allocate_reg: FPRs  >FPR: res1
  1192.         otUnknown  put: ivar> opType in FPRs
  1193.         noType       put: ivar> instrnType in FPRs
  1194.         res1 fpush
  1195.     LOOP
  1196. ;
  1197.  
  1198.  
  1199. : SETUP_CSTK  ( #gprs -- )
  1200.     true  (setup_cstk)  ;
  1201.  
  1202. : RESET_CSTK  ( #gprs -- )
  1203.     false  (setup_cstk)  ;
  1204.  
  1205. : SETUP_FCSTK  ( #fprs -- )
  1206.     true  (setup_fcstk)  ;
  1207.  
  1208. : RESET_FCSTK  ( #fprs -- )
  1209.     false  (setup_fcstk)  ;
  1210.  
  1211.  
  1212. :f UPDATE_REFS  { ^oldRef ^newRef fromCDP -- }        \ this isn't a big bottleneck
  1213.     ^oldRef ^newRef fromCDP  update_all_refs: GPRs
  1214.     ^oldRef ^newRef fromCDP  update_all_refs: FPRs
  1215.     ^oldRef ^newRef fromCDP  update_all_refs: CRs
  1216.     ^oldRef ^newRef fromCDP  update_all_refs: stored_GPRs
  1217.  
  1218.     size: cstk  0EXIT
  1219.     current: cstk
  1220.     size: cstk FOR
  1221.         i select: cstk
  1222.         ^oldRef =?: cstk  IF  ^newRef ->: cstk  THEN
  1223.     NEXT
  1224.     update_refCnts
  1225.     select: cstk
  1226. ;f
  1227.  
  1228.  
  1229.  
  1230. : OPERANDS { n \ #toPull siz -- }
  1231.     (* Ensures we have the top n stk cells in regs for a subsequent
  1232.        operation.  Pops n operands off cstk, and moves them to opnd1, opnd2
  1233.        etc., with opnd1 being the LOWEST stack cell.
  1234.        We could also free the regs, which would be safe if
  1235.        we allocate the the result reg(s) first.  But I'd have to check
  1236.        if the reference is actually a reg, and this has to be done anyway
  1237.        when I compile the op. So it might be easier to free the reg
  1238.        there, not here.
  1239.     *)
  1240.  
  1241.     size: cstk  -> siz
  1242.     n  siz  >        \ do we need to pull cells out of memory?
  1243.     IF    n  size: cstk -  -> #toPull
  1244.         #toPull
  1245.         FOR        getFreeReg: GPRs  >gpr: res1
  1246.                 SP_reg stk_offset 0 compPull: GPRs
  1247.                 1cell  ++> stk_offset
  1248.                 movedown: cstk  res1 ->: cstk
  1249.         NEXT
  1250.     THEN
  1251.     n
  1252.     SELECT[    1    ]=>    1 stk  cstk ->: opnd1
  1253.                     -1 +size: cstk
  1254.     
  1255.           [ 2    ]=>    2 stk  cstk ->: opnd1
  1256.                       1 stk  cstk ->: opnd2
  1257.                       -2 +size: cstk
  1258.  
  1259.           [ 3    ]=>    3 stk  cstk ->: opnd1
  1260.                       2 stk  cstk ->: opnd2
  1261.                       1 stk  cstk ->: opnd3
  1262.                       -3 +size: cstk
  1263.  
  1264.           [ 4    ]=>    4 stk  cstk ->: opnd1
  1265.                       3 stk  cstk ->: opnd2
  1266.                       2 stk  cstk ->: opnd3
  1267.                       1 stk  cstk ->: opnd4
  1268.                       -4 +size: cstk
  1269.  
  1270.         DEFAULT=>    ." illegal parameter to OPERANDS : " .  1 die
  1271.     ]SELECT
  1272. ;
  1273.  
  1274. : FOPERANDS { n \ #toPull siz -- }
  1275.  
  1276.     size: fcstk  -> siz
  1277.     n  siz  >        \ do we need to pull cells out of memory?
  1278.     IF    n  size: fcstk -  -> #toPull
  1279.         #toPull
  1280.         FOR        getFreeReg: FPRs  >fpr: res1
  1281.                 FSP_reg fstk_offset 0 compPull: FPRs
  1282.                 FPcell  ++> fstk_offset
  1283.                 movedown: fcstk  res1 ->: fcstk
  1284.         NEXT
  1285.     THEN
  1286.     n
  1287.     SELECT[    1    ]=>    1 fstk  fcstk ->: opnd1
  1288.                     -1 +size: fcstk
  1289.     
  1290.           [ 2    ]=>    2 fstk  fcstk ->: opnd1
  1291.                       1 fstk  fcstk ->: opnd2
  1292.                       -2 +size: fcstk
  1293.  
  1294.           [ 3    ]=>    3 fstk  fcstk ->: opnd1
  1295.                       2 fstk  fcstk ->: opnd2
  1296.                       1 fstk  fcstk ->: opnd3
  1297.                       -3 +size: fcstk
  1298.  
  1299.           [ 4    ]=>    4 fstk  fcstk ->: opnd1
  1300.                       3 fstk  fcstk ->: opnd2
  1301.                       2 fstk  fcstk ->: opnd3
  1302.                       1 fstk  fcstk ->: opnd4
  1303.                       -4 +size: fcstk
  1304.  
  1305.         DEFAULT=>    ." illegal parameter to OPERANDS : " .  1 die
  1306.     ]SELECT
  1307. ;
  1308.  
  1309. : RESULTS    \ ( n -- )  Reserves n GPRs for results
  1310.  
  1311.     SELECT[    1    ]=>        getFreeReg: GPRs  >gpr: res1
  1312.     
  1313.           [ 2    ]=>        getFreeReg: GPRs  >gpr: res1
  1314.                           getFreeReg: GPRs  >gpr: res2
  1315.  
  1316.         DEFAULT=>    ." illegal parameter to RESULTS : " .  1 die
  1317.     ]SELECT
  1318. ;
  1319.  
  1320. : FRESULTS    \ ( n -- )  Reserves n FPRs for results
  1321.  
  1322.     SELECT[    1    ]=>        getFreeReg: FPRs  >fpr: res1
  1323.     
  1324.           [ 2    ]=>        getFreeReg: FPRs  >fpr: res1
  1325.                           getFreeReg: FPRs  >fpr: res2
  1326.  
  1327.         DEFAULT=>    ." illegal parameter to RESULTS : " .  1 die
  1328.     ]SELECT
  1329. ;
  1330.  
  1331. : SWAP_CSTK
  1332.     2 operands
  1333.     opnd2 push  opnd1 push  ;
  1334.  
  1335. : ROT_CSTK
  1336.     3 operands
  1337.     opnd2 push  opnd3 push  opnd1 push  ;
  1338.  
  1339.  
  1340. (*    CR_RESULT reserves a CR field.  If it's for a comparison result,
  1341.     the actual condition must be in subOperation.  The result is
  1342.     left in res1, and the allocated CR reg is left selected.
  1343.     If it's just to get a free CR reg for a CR logical operation, 
  1344.     don't bother setting subOperation, and ignore res1.
  1345.     If we want a particular CR (which may be CR0 for an integer op or CR1
  1346.     for an FP op, we pass true for wantOne? as well as the reg# we want
  1347.     and the CDP where the op is to be compiled.  If we don't want a
  1348.     particular one, we pass false and the other two parameters are ignored.
  1349. *)
  1350.  
  1351. : CR_RESULT  { wantOne? CR#_wanted CDP_where_used \ gotit? -- }
  1352.     false  -> gotit?
  1353.     wantOne?
  1354.     IF    CR#_wanted select: CRs
  1355.         get: ivar> refCnt in CRs
  1356.         NIF    get: ivar> opCDP in CRs  CDP_where_used  u<=  -> gotit?
  1357.         THEN
  1358.         
  1359.         gotit?
  1360.         IF    allocate: CRs  CR#_wanted  THEN
  1361.     THEN
  1362.     
  1363.     gotit?
  1364.     NIF
  1365.         0 select: CRs  allocate: CRs    \ temporarily, to ensure they won't be free
  1366.         1 select: CRs  allocate: CRs
  1367.         getFreeReg: CRs
  1368.         0 select: CRs  free: CRs
  1369.         1 select: CRs  free: CRs
  1370.     THEN
  1371.     
  1372. ( CR# we got )
  1373.     dup >CR: res1  select: CRs
  1374.     subOperation >condition: res1
  1375.     res1 ->: ivar> myRef in CRs
  1376. ;
  1377.  
  1378.  
  1379.  
  1380. 0    value    svSelector
  1381. 0    value    svOpcode
  1382.  
  1383. objPtr    matchedOD  class_is OD
  1384.  
  1385. : MATCH&ALLOCATE?  { canBeSpecial? -- b }
  1386.     theOD canBeSpecial?  match?  NIF  false  EXIT  THEN
  1387.     
  1388.     false -> check_OP_stores?
  1389.     -> matchedOD
  1390.     true -> check_OP_stores?
  1391.  
  1392.     debug? if
  1393.         ." match&allocate? matched on reg: "  print: matchedOD  cr
  1394.     then
  1395.     allocate: matchedOD  addr: ivar> myRef in matchedOD  ->: res1
  1396.  
  1397. \ if it's a CR result, although we've matched on the CR field, the
  1398. \ condition might be different.  So we make sure we set the right
  1399. \ condition in res1 and the matching CR reg.  The condition should
  1400. \ be in subOperation.
  1401.  
  1402.     refType: res1  crRef =
  1403.     IF    subOperation >condition: res1
  1404.         res1 ->: ivar> myRef in CRs
  1405.     THEN
  1406.     true
  1407. ;
  1408.  
  1409.  
  1410. \ LIT>GPR compiles the passed in literal value in a gpr, and leaves
  1411. \  res1 set to that gpr.  Uses theOD.  
  1412. \ Note: This is only called from equalization, where we mustn't ever ever 
  1413. \  generate duplicate references (since we're getting rid of them!),
  1414. \  so we don't look for a match.
  1415.  
  1416. : LIT>GPR  { n canBeSpecial? -- }
  1417.     n setLit: theOD
  1418.  
  1419.     debug? if
  1420.         ." lit>gpr - theOD:" print: theOD
  1421.     then
  1422.  
  1423. \    canBeSpecial?  match&allocate?  ?EXIT - aauugghhh!!
  1424.     getFreeReg: GPRs  >gpr: res1
  1425.     theOD ->: GPRs  compile: GPRs
  1426. ;
  1427.  
  1428.  
  1429. : LIT>SELECTED_GPR  { n -- }
  1430.     n setLit: GPRs
  1431.     compile: GPRs
  1432. ;
  1433.  
  1434. : LIT>THIS_GPR  { n gpr# -- }
  1435.     gpr# select: GPRs
  1436.     n setLit: GPRs  compile: GPRs
  1437. ;
  1438.  
  1439.  
  1440. : MARK_GPR_INITIALIZED  ( gpr# -- )
  1441.     select: GPRs
  1442.     1 put: ivar> opType in GPRs
  1443. ;
  1444.  
  1445.  
  1446. : MARK_FPR_INITIALIZED  ( fpr# -- )
  1447.     select: FPRs
  1448.     1 put: ivar> opType in FPRs
  1449. ;
  1450.  
  1451.  
  1452. 0    value    #CRs_pushed
  1453. 0    value    #FPRs_pushed
  1454.  
  1455.  
  1456.  
  1457. (*    CR>THIS_GPR compiles the sequence to convert a CR bit reference to
  1458.     a true or false in the GPR whose number is passed in.
  1459.     
  1460.     This stuff looks incredibly complicated, but that's because we try
  1461.     to generate the optimized sequences given in the Compiler Writers'
  1462.     Guide, whenever we can, and there are a lot of special cases.
  1463.     
  1464.     One way to do the job would be to put a -1 into the reg, then
  1465.     conditionally branch over a clear of the reg.  But we should always try 
  1466.     to eliminate branches.  The most general way is to move the CR to a reg, 
  1467.     then rotate-left-and-mask to get the desired bit into the low bit position 
  1468.     of the reg.  Then unlike C, we need to add a negate or a subtact 1, so that
  1469.     we get a proper true flag.  We handle this general case in do_cr_op below.
  1470.     
  1471.     But in most cases we can do better.  The Guide says that CR ops can
  1472.     cause a stall since they operate on the whole CR, and so clobber any
  1473.     parallelism involving different CR fields.  So if we can, we avoid
  1474.     using a CR op.  Now if the CR result is a comparison (which it usually is), 
  1475.     then we can change the op to a subfc or something similar, then do 2 or 3 
  1476.     instructions of bit twiddling to get a flag without any CR ops or branches.
  1477.     The code sequences are very obscure, involving some unobvious uses of the 
  1478.     carry flag.
  1479.     
  1480.     All this is further complicated by the fact that we can't really compile
  1481.     arbitrary code here since
  1482.     1. Routines like compRegReg aren't re-entrant, and
  1483.        assume theOD stays valid.
  1484.     2. We might be called from within equalization which means we should
  1485.        leave other regs alone.
  1486.     3. We can't use r12 (rY) since we might be in the middle of setting
  1487.        up a method call.  We can use r10 and r11 (rX and rZ).
  1488.     4. If we have to do the subtract 1, we can't be in r0 (addi doesn't work
  1489.         (on r0).
  1490.     
  1491.     So we basically use rX, rZ and r0 where we can, target the destination
  1492.     gpr with the final instruction, hand-wind things and leave everything 
  1493.     else alone.
  1494.  
  1495.     We also free the CR here since that usually simplifies things for the 
  1496.     caller, and we're definitely finished with the CR once we've moved its 
  1497.     value to a GPR.
  1498. *)
  1499.  
  1500.  
  1501. : make_flag  { reg1 reg2 gpr# 1_is_true? otCode -- }
  1502.  
  1503.     1_is_true?
  1504.     IF  gpr#  ELSE  rZ_reg  THEN  select: GPRs
  1505.  
  1506.     reg2 >Agpr: GPRs  reg1 >Bgpr: GPRs
  1507.     otCode put: ivar> opType in GPRs
  1508.     compile: GPRs
  1509.     
  1510.     1_is_true?
  1511.     NIF
  1512.         gpr# select: GPRs
  1513.         rZ_reg >Agpr: GPRs  clear: ivar> B_opnd in GPRs
  1514.         otNOT put: ivar> opType in GPRs
  1515.         compile: GPRs
  1516.     THEN
  1517.     set: ivar> dontHoist? in GPRs    \ it depends on hand-wound preceding
  1518.                                     \  code, so mustn't move
  1519. ;
  1520.  
  1521.  
  1522. : make_flag_for_zcomp  { reg gpr# litval otCode subcode -- }
  1523.     gpr# select: GPRs
  1524.     otCode put: ivar> opType in GPRs 
  1525.     subcode put: ivar> subtype in GPRs        \ right arithmetic shift
  1526.     reg >Agpr: GPRs
  1527.     litval >Blit: GPRs
  1528.     compile: GPRs
  1529.     set: ivar> dontHoist? in GPRs
  1530. ;
  1531.  
  1532.  
  1533. : do_signed_comp_with_zero  { reg gpr# rev? 1_is_true? -- }
  1534.  
  1535. \    reg >Agpr: GPRs
  1536.  
  1537.     rev?
  1538.     IF    1_is_true?
  1539.         IF                            \ 0>
  1540.             otSubfc put: ivar> opType in GPRs
  1541.             0 >Blit: GPRs
  1542.             compile: GPRs
  1543.  
  1544. \            0 gpr# 31 otShift 3  make_flag_for_zcomp
  1545.  
  1546.             $ 540A0FFE
  1547.             reg 21 << or  code,        \ rlwinm  rZ, reg, 1, 31, 31
  1548.  
  1549.             rZ_reg dup gpr# true otAddme  make_flag
  1550.  
  1551.         ELSE                        \ 0<=
  1552.         
  1553.             otAddc  put: ivar> opType in GPRs
  1554.             -1 >Blit: GPRs
  1555.             compile: GPRs
  1556.             
  1557. \            0 gpr# 31 otShift 3  make_flag_for_zcomp
  1558. \
  1559. \            otAddic put: ivar> opType in GPRs
  1560. \            -1 >Blit: GPRs
  1561. \            compile: GPRs
  1562. \
  1563.             $ 540A0FFE
  1564.             reg 21 << or  code,        \ rlwinm  rZ, reg, 1, 31, 31
  1565.  
  1566.             rZ_reg dup gpr# true otSubfze  make_flag
  1567.  
  1568.         THEN
  1569.     ELSE
  1570.         1_is_true?
  1571.         IF                            \ 0<
  1572.             reg gpr# 31 otShift 3  make_flag_for_zcomp
  1573.         ELSE                        \ 0>=
  1574.             $ 540A0FFE
  1575.             reg 21 << or  code,        \ rlwinm  rZ, reg, 1, 31, 31
  1576.             rZ_reg gpr# -1 otAdd 0  make_flag_for_zcomp
  1577.         THEN
  1578.     THEN
  1579. ;
  1580.  
  1581.  
  1582. : do_signed_lit_op  { reg gpr# litval rev? 1_is_true? -- }
  1583.  
  1584.     0 select: GPRs
  1585.     reg >Agpr: GPRs
  1586. \    addr: CRs copyWithCDP: GPRs
  1587. \    delete: CRs                        \ we'll instead be doing an op into r0
  1588.     clear: ivar> subtype in GPRs    \ we always want this
  1589.  
  1590.     litval
  1591.     NIF  reg gpr# rev? 1_is_true?  do_signed_comp_with_zero  EXIT  THEN
  1592.  
  1593.     1_is_true?
  1594.     NIF
  1595.         rev? IF  1 ++> litval  ELSE  1 --> litval  THEN
  1596.         not> rev?
  1597.     THEN
  1598.  
  1599.     rev?
  1600.     NIF        rX_reg  rZ_reg  litval negate    otAddc
  1601.     ELSE    rZ_reg  rX_reg  litval            otSubfc
  1602.     THEN
  1603.     put: ivar> opType in GPRs
  1604.     >Blit: GPRs
  1605.     compile: GPRs
  1606.  
  1607.   ( rZ/rX ) 21 <<
  1608.     $ 39400000  or
  1609.     litval 31 >> or  code,        \ li        rZ/rX, 1/0
  1610.   ( rX/rZ )  16 <<
  1611.     $ 54000FFE  or
  1612.     reg 21 << or  code,            \ rlwinm    rX/rZ, reg, 1, 31, 31
  1613.  
  1614.     rX_reg  rZ_reg  gpr#  true  otSubfe  make_flag
  1615. ;
  1616.  
  1617.  
  1618. : do_signed_op  { reg1 reg2 gpr# litval 1_is_true? -- }
  1619.  
  1620.     reg1 0< IF  reg2 gpr# litval false 1_is_true?  do_signed_lit_op  EXIT  THEN
  1621.     reg2 0< IF  reg1 gpr# litval true  1_is_true?  do_signed_lit_op  EXIT  THEN
  1622.  
  1623.     1_is_true?
  1624.     IF    $ 540A0FFE
  1625.         reg1 21 << or  code,    \    rlwinm    rZ, reg1, 1, 31, 31
  1626.         $ 540B0FFE
  1627.         reg2 21 << or  code,    \    rlwinm    rX, reg2, 1, 31, 31
  1628.         otSubfc
  1629.     ELSE
  1630.         $ 6C0A8000 
  1631.         reg1 21 << or  code,    \    xoris    rZ, reg1, $ 8000
  1632.         otSub
  1633.     THEN
  1634.  
  1635.     0 select: GPRs
  1636. \    addr: CRs copyWithCDP: GPRs
  1637. \    delete: CRs            \ we'll instead be doing some kind of subtract into r0
  1638.  ( code ) put: ivar> opType in GPRs  clear: ivar> subtype in GPRs
  1639.      reg2 >Agpr: GPRs  reg1 >Bgpr: GPRs
  1640.     compile: GPRs
  1641.     1_is_true?
  1642.     IF
  1643.         rX_reg  rZ_reg
  1644.     ELSE
  1645.         $ 7C005014  code,        \    addc    r0, r0, rZ
  1646.         0  0
  1647.     THEN
  1648.     gpr#  true  otSubfe  make_flag
  1649. ;
  1650.  
  1651.  
  1652. : do_unsigned_op  { reg1 reg2 gpr# litval 1_is_true? -- }
  1653.  
  1654.     rZ_reg select: GPRs
  1655. \    addr: CRs copyWithCDP: GPRs
  1656. \    delete: CRs                \ we'll instead be doing a subfc into rZ
  1657.  
  1658.     reg2 0<
  1659.     IF
  1660.         litval >Blit: GPRs
  1661.         reg1  otSubfc
  1662.     ELSE
  1663.         reg1 0<
  1664.         IF    litval negate >Blit: GPRs
  1665.             reg2  otAddc
  1666.         ELSE
  1667.             reg1 >Bgpr: GPRs
  1668.             reg2  otSubfc
  1669.         THEN
  1670.     THEN
  1671.     put: ivar> opType in GPRs  >Agpr: GPRs
  1672.     clear: ivar> subtype in GPRs
  1673.     compile: GPRs                \ subfc  rZ, reg1, reg2 or whatever
  1674.  
  1675.     rZ_reg dup gpr# 1_is_true? otSubfe  make_flag
  1676. ;
  1677.  
  1678.  
  1679. : do_zero_test  { reg1 gpr# 1_is_true? -- }
  1680.     reg1 >Agpr: GPRs
  1681.     1_is_true?
  1682.     IF
  1683.         -1 >Blit: GPRs
  1684.         otAddc put: ivar> opType in GPRs
  1685.     ELSE
  1686.         0 >Blit: GPRs
  1687.         otSubfc put: ivar> opType in GPRs
  1688.     THEN
  1689.     compile: GPRs
  1690.  
  1691.     rZ_reg dup gpr# true otSubfe  make_flag
  1692.                             \ flag will be already the right way around
  1693.                             \  so we pass true, not 1_in_true? - and we
  1694.                             \  won't need the adjustment instruction.
  1695. ;
  1696.  
  1697.  
  1698. : do_equality  { reg1 reg2 gpr# litval 1_is_true? -- }
  1699.     rZ_reg select: GPRs
  1700. \    addr: CRs copyWithCDP: GPRs        \ we'll be replacing the compare with an xor
  1701.                                     \  into rZ, and not use the CR field at all
  1702.  
  1703.     otXOR put: ivar> opType in GPRs  clear: ivar> subtype in GPRs
  1704.     reg1 >Agpr: GPRs
  1705.     reg2 0<
  1706.     IF            \ it's literal - and if zero, we can do even better, by
  1707.                 \  deleting the CR op, omitting the xor entirely, and
  1708.                 \  skipping straight to our final zero test.
  1709.         litval
  1710.         NIF
  1711. \            delete: CRs
  1712.             reg1 gpr# 1_is_true?  do_zero_test  EXIT
  1713.         THEN
  1714.         litval >Blit: GPRs
  1715.     ELSE
  1716.         reg2 >Bgpr: GPRs
  1717.     THEN
  1718. \    recompile: GPRs                    \ xor  rZ, reg1, reg2 / xori rZ, reg1, litval
  1719.     compile: GPRs
  1720.  
  1721.     rZ_reg gpr# 1_is_true?  do_zero_test
  1722.  
  1723. \    update_refcnts
  1724.     debug? if
  1725.         ." cr>this_gpr used do_equality, leaving result in:" print: GPRs  cr dasm .al
  1726.     then
  1727. ;
  1728.  
  1729.  
  1730. : do_cr_op  { gpr# field# bit# 1_is_true? -- }
  1731.  
  1732.     rX_reg  select: GPRs
  1733.  
  1734.     $ 7C000026  rX_reg 21 << or  code,            \ mfcr  rX
  1735.     
  1736. \ We now get the bit we want into the low bit posn of rX.
  1737.  
  1738.     otShift&mask put: ivar> opType in GPRs
  1739.     rX_reg  >Agpr: GPRs
  1740.     field# 4*  bit# + 1+  >Blit: GPRs    \ rotate by one more than the bit #
  1741.                                         \  to get it into the low bit posn
  1742.     31 put: ivar> maskBegin in GPRs
  1743.     31 put: ivar> maskEnd   in GPRs
  1744.     compile: GPRs
  1745.  
  1746. \ now we have to do a negate or subtract 1.  We now target the requested gpr#,
  1747. \ and leave it selected at the end.  There's no problem if this is r0.
  1748.  
  1749.     gpr# select: GPRs
  1750.  
  1751.     rX_reg  >Agpr: GPRs
  1752.     1_is_true?
  1753.     IF            \ we need to do a negate.
  1754.         otNeg put: ivar> opType in GPRs
  1755.         noRef >Btype: GPRs
  1756.     ELSE        \ we need to do an addi -1.
  1757.         otAdd put: ivar> opType in GPRs
  1758.         -1 >Blit: GPRs
  1759.     THEN
  1760.     compile: GPRs
  1761.  
  1762.     debug? if
  1763.         ." cr>this_gpr used do_cr_op, leaving result in:" print: GPRs  cr dasm
  1764.     then
  1765. ;
  1766.  
  1767.  
  1768. : CR>THIS_GPR  { ^ref gpr# \ field# bit# 1_is_true? reg1 reg2 litval op opt? cmpCDP -- }
  1769.  
  1770.     debug? if
  1771.         cr ." cr>this_gpr called with:" cr
  1772.         print: [ ^ref ]
  1773.         ."  to go to gpr" gpr# . cr
  1774.         printall: cstk
  1775.     then
  1776.  
  1777.     -1 -> litval  false -> opt?
  1778.     
  1779. \ now, what's the bit in rX that we want?
  1780.  
  1781.     ^ref  get: ivar> field#        in class_as> reference  -> field#
  1782.     ^ref  get: ivar> bit#        in class_as> reference  -> bit#
  1783.     ^ref  get: ivar> 1_is_true?    in class_as> reference  -> 1_is_true?
  1784.  
  1785.     field# select: CRs
  1786.     get: ivar> opCDP in CRs  -> cmpCDP
  1787.     free: CRs                \ we always want it freed, and it's safe to do
  1788.                             \  it now
  1789.  
  1790. \ we don't try to do a better optimization if the op isn't a
  1791. \  compare.
  1792.  
  1793.     get: ivar> opType in CRs  -> op
  1794.     op otUCMP =  op otCMP =  or
  1795.     
  1796.     IF    true -> opt?
  1797.  
  1798. \ which optimized sequence we use depends on what the op is, and the
  1799. \  exact condition we're testing for.
  1800.  
  1801.         Areg: CRs -> reg1
  1802.         reg1 select: GPRs  get: ivar> opCDP in GPRs  cmpCDP u>
  1803.         IF
  1804.             false -> opt?
  1805.         ELSE
  1806.             Btype: CRs  litRef =
  1807.             IF    Blit: CRs -> litVal
  1808.                 -1 -> reg2
  1809.                 litval $ ffff8000 = IF  false -> opt?  THEN
  1810.                         \ if optimizing we sometimes negate the literal - if it's the max
  1811.                         \  neg 16-bit number this won't work, so as this is very unusual
  1812.                         \  we'll just not do the optimization in this case.
  1813.                         
  1814.                 op otUCMP =  IF litval NIF  false -> opt?  THEN  THEN
  1815.                         \ likewise if the op is unsigned and the lit is zero, the algorithm 
  1816.                         \  won't work properly.  But again this is a rather bizarre case so
  1817.                         \  we'll just avoid it.
  1818.     
  1819.             ELSE
  1820.                 Breg: CRs -> reg2
  1821.                 reg2 select: GPRs  get: ivar> opCDP in GPRs  cmpCDP u>
  1822.                 IF
  1823.                     false -> opt?  
  1824.                 THEN
  1825.             THEN
  1826.         THEN
  1827.     THEN
  1828.     
  1829.     opt?
  1830.     NIF                    \ we have to do it the conservative way
  1831.         gpr# field# bit# 1_is_true?  do_cr_op  EXIT
  1832.     THEN
  1833.     
  1834.     ?delete: CRs        \ delete the compare if it's safe to do so
  1835.  
  1836.     bit# 2 = IF  reg1 reg2 gpr# litval 1_is_true?  do_equality  EXIT  THEN
  1837.  
  1838.     reg1  reg2  bit# NIF  swap  THEN
  1839.     op otCMP =
  1840.     IF
  1841.         gpr# litval 1_is_true?  do_signed_op
  1842.     ELSE
  1843.         gpr# litval 1_is_true?  do_unsigned_op
  1844.     THEN
  1845.  
  1846. \    update_refcnts
  1847.     debug? if
  1848.         ." cr>this_gpr finished, leaving result in:" print: GPRs  cr dasm .al
  1849.     then
  1850. ;
  1851.  
  1852.  
  1853. \ CR>GPR is similar, but grabs a free GPR to use, and leaves its reference
  1854. \  in res1.  Frees the CR field.
  1855.  
  1856. : CR>GPR  ( ^ref -- )
  1857.     getFreeReg: GPRs  dup >gpr: res1
  1858.     cr>this_gpr
  1859. ;
  1860.  
  1861.  
  1862. \ __>g can be used in an inline defn to force a comparison result into
  1863. \  a GPR, for those situations where we know this will give better
  1864. \  code.
  1865.  
  1866. : __>g
  1867.     1 operands
  1868.     opnd1 push
  1869.     reftype: opnd1  crRef <>  ?EXIT        \ do nothing if we don't have a
  1870.                                         \  CR reference
  1871.     1 operands
  1872.     opnd1  cr>gpr  res1 push
  1873. ;            immediate
  1874.  
  1875.  
  1876. : PUSH_TO_MEM  { ^ref stkReg stkOffs update? \ refType -- }
  1877.     ^ref refType: class_as> reference
  1878.     SELECT[    gprRef    ]=>        ^ref reg: class_as> reference  select: GPRs
  1879.                             stkReg stkOffs update? compPush: GPRs
  1880.                             
  1881.           [    fprRef    ]=>        ^ref reg: class_as> reference  select: FPRs
  1882.                               stkReg stkOffs update? compPush: FPRs
  1883.  
  1884.           [    CRref    ]=>    \ we have to convert to a flag, since once
  1885.                           \  a cell is pushed to mem we don't know what
  1886.                           \  it is any more.
  1887.  
  1888.                               ^ref 0 cr>this_gpr        \ leaves r0 selected
  1889.                               stkReg stkOffs update? compPush: GPRs
  1890.  
  1891.           [    litRef    ]=>    \ we have to get the lit to a GPR then push it.
  1892.                           \ We might be doing a spill, so we won't allocate
  1893.                           \ a free GPR (there mightn't be one), but just
  1894.                           \ use r0.
  1895.                               ^ref lit: class_as> reference
  1896.                               0 select: GPRs  lit>selected_gpr
  1897.                             stkReg stkOffs update? compPush: GPRs
  1898.  
  1899.           DEFAULT=>        drop
  1900.     ]SELECT
  1901. ;
  1902.  
  1903.  
  1904. : PUSH&MOVEUP
  1905.     0 select: cstk
  1906.     refType: cstk  FPRref =
  1907.     IF
  1908.         8 --> fstk_offset
  1909.         cstk FSP_reg fstk_offset false push_to_mem
  1910.     ELSE
  1911.         1cell --> stk_offset
  1912.         cstk SP_reg stk_offset false push_to_mem
  1913.     THEN
  1914.     moveUp: cstk
  1915. ;
  1916.  
  1917.  
  1918. :f SPILL
  1919.     debug? if
  1920.         ." spilling to get a free reg" cr printall: cstk  .al
  1921.         .gs
  1922. \        [ ppc? not ] [if] zs [then]
  1923.     then
  1924.  
  1925. spillODs  FPRs = IF  ." FPR spill!!" cr [ ppc? ] [if] dbgr [then] then
  1926.  
  1927.     0 -> #gprs_cleared
  1928.     BEGIN
  1929.  
  1930. size: cstk 0= if
  1931. printall: cstk .al .gs cr
  1932. dasm
  1933. 1 die
  1934. then
  1935.  
  1936.         push&moveup
  1937.         #gprs_cleared spill_cnt >=
  1938.         size: cstk 0= or
  1939.     UNTIL
  1940.     debug? if
  1941.         ." after spill:" cr printall: cstk
  1942.     then
  1943. ;f
  1944.  
  1945.  
  1946. : GET_TO_REG?  { ^ref \ changed? -- changed? }
  1947.     false -> check_OP_stores?
  1948.     ^ref -> aRef        \ may be a reference_list, not a reference, but OK
  1949.     true -> check_OP_stores?
  1950.     false -> changed?
  1951.     
  1952.     refType: aRef
  1953.     SELECT[    litRef    ]=>        lit: aRef  true  lit>gpr  res1 ->: aRef
  1954.                             true -> changed?
  1955.           [    gprRef    ]=>
  1956.           [    fprRef    ]=>
  1957.           [    crRef    ]=>
  1958.           DEFAULT=>            drop
  1959.     ]SELECT
  1960.     changed?
  1961. ;
  1962.  
  1963.  
  1964. : GET_TO_GPR?  { ^ref \ changed? -- changed? }
  1965.     false -> check_OP_stores?
  1966.     ^ref -> aRef        \ may be a reference_list, not a reference, but OK
  1967.     true -> check_OP_stores?
  1968.     false -> changed?
  1969.     
  1970.     refType: aRef
  1971.     SELECT[    gprRef    ]=>            \ nothing to do!
  1972.                             
  1973.           [    fprRef    ]=>        to_be_written
  1974.  
  1975.           [    CRref    ]=>        aRef  cr>gpr
  1976.                               res1 ->: aRef  true -> changed?
  1977.  
  1978.           [    litRef    ]=>        lit: aRef  true  lit>gpr
  1979.                               res1 ->: aRef  true -> changed?
  1980.  
  1981.           DEFAULT=>        drop
  1982.     ]SELECT
  1983.     changed?
  1984.     debug? if
  1985.         ." get_to_gpr? leaves result in: " print: res1  cr
  1986.     then
  1987. ;
  1988.  
  1989.  
  1990. : GET_TO_THIS_GPR  { ^ref reg# -- }
  1991.     false -> check_OP_stores?
  1992.     ^ref -> aRef        \ may be a reference_list, not a reference, but OK
  1993.     true -> check_OP_stores?
  1994.     
  1995.     refType: aRef
  1996.     SELECT[    gprRef    ]=>        reg: aRef  reg#  true  moveReg: GPRs
  1997.                             
  1998.           [    fprRef    ]=>        to_be_written
  1999.  
  2000.           [    CRref    ]=>        aRef  reg#  cr>this_gpr
  2001.  
  2002.           [    litRef    ]=>        lit: aRef  reg#  lit>this_gpr
  2003.  
  2004.           DEFAULT=>        drop
  2005.     ]SELECT
  2006.     
  2007.     reg# >gpr: res1  res1 ->: aRef
  2008.     
  2009.     debug? if
  2010.         ." get_to_this_gpr leaves result in: " print: res1  cr
  2011.     then
  2012. ;
  2013.  
  2014.  
  2015. :f .G    select: GPRs  print: GPRs  ;f
  2016. :f .F    select: FPRs  print: FPRs  ;f
  2017. :f .C    select: CRs   print: CRs   ;f
  2018.  
  2019. :f .GS        printall: GPRs  ;f
  2020. :f .CS        printall: CRs   ;f
  2021. :f .AL        ." GPRs:" cr .allocated: GPRs  ." CRs" cr .allocated: CRs
  2022.             ." FPRs:" cr .allocated: FPRs  cr  ;f
  2023. :f .FR        .free:    GPRs  ;f
  2024. :f .FAL        ." FPRs:" cr .allocated: FPRs  ;f
  2025.  
  2026.  
  2027. : .g3
  2028.     3 select: GPRs  print: GPRs
  2029. ;
  2030.  
  2031. : .cstk
  2032.     printall: cstk  ;
  2033.  
  2034. : .cstk2
  2035.     printall: cstk2  ;
  2036.  
  2037. : .cflgs
  2038.     printall: control_flags  ;
  2039.  
  2040.  
  2041. endload
  2042.  
  2043. \ =========== the current test block ============
  2044.  
  2045. +echox
  2046.  
  2047. int ii
  2048.  
  2049. :f TEST { \ x -- }
  2050.     cr cr ." hi there one and all!" cr  1 2 3
  2051.     begin
  2052.         query cr
  2053.         begin
  2054.             rest nip 0>
  2055.         while
  2056.             defined?
  2057.             if        execute
  2058.             else
  2059.                     number
  2060.                     setup_cg
  2061.                     .al
  2062.                     get: ivar> opType in GPRs  otNOT  = .
  2063.             then
  2064.         repeat
  2065.         .s cr
  2066.     again
  2067. ;f
  2068.  
  2069. :f quit  test  ;f        \ temp so we can catch errors!
  2070.  
  2071.  
  2072. endload